home *** CD-ROM | disk | FTP | other *** search
/ EuroCD 3 / EuroCD 3.iso / MIDI / Utilities / CS1x-Ed / Midilib / basic / cpg < prev    next >
Text File  |  1998-06-24  |  4KB  |  185 lines
  1. DEFLNG a-Z
  2.  
  3. 'Assumes exec.bmap and midi.bmap in the current directory
  4. LIBRARY "exec.library"
  5. LIBRARY "midi.library"
  6.  
  7. DECLARE FUNCTION AllocMem() LIBRARY
  8. memf.public = 1
  9. memf.clear = 65536&
  10.  
  11. DECLARE FUNCTION CreateMDest() LIBRARY
  12. DECLARE FUNCTION CreateMSource() LIBRARY
  13. DECLARE FUNCTION GetMidiMsg() LIBRARY
  14. DECLARE FUNCTION MRouteDest() LIBRARY
  15. DECLARE FUNCTION MRouteSource() LIBRARY
  16. DestName$="MidiOut"+CHR$(0)
  17. SourceName$="MidiIn"+CHR$(0)
  18. NoteOn=&H90
  19. DefaultVelocity=&H40
  20.  
  21. NoteBufSize=12
  22. NoteBuf=AllocMem(NoteBufSize,memf.public+memf.clear)
  23. IF NoteBuf=0 THEN CloseDown
  24.  
  25. InRouteInfoSize=14
  26. InRouteInfo=AllocMem(InRouteInfoSize,memf.public+memf.clear)
  27. IF InRouteInfo=0 THEN CloseDown
  28. POKEW InRouteInfo  ,&H2     'Allow only Note On messages
  29. POKEW InRouteInfo+2,&HFFFF  'pass all channels
  30.  
  31. OutRouteInfoSize=14
  32. OutRouteInfo=AllocMem(OutRouteInfoSize,memf.public+memf.clear)
  33. IF OutRouteInfo=0 THEN CloseDown
  34. POKEW OutRouteInfo  ,&HFFFF  'Allow all messages
  35. POKEW OutRouteInfo+2,&HFFFF  'pass all channels
  36.  
  37. CPG:
  38. LOCATE 2,10 : PRINT"CPG for the Amiga"
  39. PRINT" by Jim McConkey after Atari ST original by Jim Johnson"
  40. PRINT" Published in Electronic Musician, April 1988, pp 22-30"
  41. Dest=CreateMDest(0&,0&)
  42. IF Dest=0 THEN PRINT"Can't create Dest": GOTO CloseDown
  43. Source=CreateMSource(0&,0&)
  44. IF Source=0 THEN PRINT"Can't create Source": GOTO CloseDown
  45.  
  46. Out=MRouteSource(Source,SADD(DestName$),OutRouteInfo)
  47. IF Out=0 THEN PRINT"Can't route MIDI output": GOTO CloseDown
  48. In=MRouteDest(SADD(SourceName$),Dest,InRouteInfo)
  49. IF In=0 THEN PRINT"Can't route MIDI input" : GOTO CloseDown
  50.  
  51.  GOSUB SetVar
  52. Start:
  53.  GOSUB SetBuff
  54.  GOSUB DoScreen
  55.  GOSUB GetScale
  56.  GOSUB MakeProg
  57.  GOSUB MakeChords
  58.  GOSUB Play
  59.  GOSUB AskMore
  60.  IF a$<>"N" THEN GOTO Start
  61.   
  62. CloseDown:
  63. IF Dest<>0 THEN CALL DeleteMDest(Dest)
  64. IF Source<>0 THEN CALL DeleteMSource(Source)
  65. IF In<>0 THEN CALL DeleteMRoute(In)
  66. IF Out<>0 THEN CALL DeleteMRoute(Out)
  67. IF InRouteInfo<>0 THEN CALL FreeMem(InRouteInfo,InRouteInfoSize)
  68. IF OutRouteInfo<>0 THEN CALL FreeMem(OutRouteInfo,OutRouteInfoSize)
  69. IF NoteBuff<>0 THEN CALL FreeMem(NoteBuff,NoteBufSize)
  70. LIBRARY CLOSE : CLS
  71. END
  72.  
  73. SetBuff:
  74.  FOR j=0 TO 3
  75.   POKE NoteBuf+3*j  ,NoteOn
  76.   POKE NoteBuf+3*j+1,0
  77.   POKE NoteBuf+3*j+2,DefaultVelocity
  78.  NEXT
  79. RETURN
  80.  
  81. DoScreen:
  82.  LOCATE 15,10
  83.  PRINT "Chord Progression Generator" : PRINT 
  84. RETURN
  85.  
  86. SetVar:
  87.  DIM Scale(8),Chord(100,4),Prog(100),Type(7)
  88.  I=1 : II=2 : III=3 : IV=4 : V=5 : VI=6 : VII=7
  89.  Tonic=1 : Digress=2 : Approach=3
  90.  Type(I)=Tonic : Type(II)=Digress : Type(III)=Digress
  91.  Type(IV)=Approach : Type(V)=Approach
  92.  Type(VI)=Digress : Type(VII)=Approach
  93. RETURN
  94.  
  95. GetScale:
  96.  CALL FlushMDest(Dest)     'Clean out buffer
  97.  FOR j=1 TO 8              'Now get scale
  98.   LOCATE 17,10
  99.   PRINT "Enter scale note"j
  100.   NoteMsg=0
  101.   WHILE NoteMsg=0
  102.    NoteMsg=GetMidiMsg(Dest)
  103.   WEND
  104.   Scale(j)=PEEK(NoteMsg+1)
  105.   FreeMidiMsg(NoteMsg)
  106.  NEXT
  107.  LOCATE 17,10 : PRINT SPACE$(20)
  108. RETURN
  109.  
  110. MakeProg:
  111.  RANDOMIZE(0)
  112.  Prog(1)=I
  113.  FOR j=2 TO 100
  114.   Rn!=(RND)^1.3
  115.   IF Type(Prog(j-1))=Tonic THEN
  116.    ON INT(Rn!*6)+1 GOSUB T3,T4,T6,T5,T2,T7
  117.   ELSEIF Type(Prog(j-1))=Digress THEN 
  118.    ON INT(Rn!*3)+1 GOSUB T5,T7,T1
  119.   ELSEIF Type(Prog(j-1))=Approach THEN 
  120.    GOSUB T1
  121.   END IF
  122.   IF j>=5 AND Type(Prog(j-1))=Approach THEN Prog(j+1)=0 : j=100
  123.  NEXT
  124. RETURN
  125.  
  126. T1: Prog(j)=I   : RETURN
  127. T2: Prog(j)=II  : RETURN
  128. T3: Prog(j)=III : RETURN
  129. T4: Prog(j)=IV  : RETURN
  130. T5: Prog(j)=V   : RETURN
  131. T6: Prog(j)=VI  : RETURN
  132. T7: Prog(j)=VII : RETURN
  133.  
  134. MakeChords:
  135.  j=1
  136.  WHILE Prog(j)<>0
  137.   Root=Prog(j)
  138.   Third=Root+2
  139.   IF Third>8 THEN Third=Third-7
  140.   Fifth=Root+4
  141.   IF Fifth>8 THEN Fifth=Fifth-7
  142.   Chord(j,1)=Scale(Root)-12
  143.   Chord(j,2)=Scale(Root)
  144.   Chord(j,3)=Scale(Third)
  145.   Chord(j,4)=Scale(Fifth)
  146.   j=j+1
  147.  WEND
  148. RETURN
  149.  
  150. Play:
  151.  j=1
  152.  WHILE Prog(j)<>0
  153.   POKE NoteBuf+1,Chord(j,1)
  154.   POKE NoteBuf+4,Chord(j,2)
  155.   POKE NoteBuf+7,Chord(j,3)
  156.   POKE NoteBuf+10,Chord(j,4)
  157.   CALL PutMidiStream(Source,0,NoteBuf,12,12)
  158.   POKE NoteBuf+2,0
  159.   POKE NoteBuf+5,0
  160.   POKE NoteBuf+8,0
  161.   POKE NoteBuf+11,0
  162.   FOR j2=1 TO 2000 : NEXT
  163.   CALL PutMidiStream(Source,0,NoteBuf,12,12)
  164.   POKE NoteBuf+2,DefaultVelocity
  165.   POKE NoteBuf+5,DefaultVelocity
  166.   POKE NoteBuf+8,DefaultVelocity
  167.   POKE NoteBuf+11,DefaultVelocity
  168.   FOR j2=1 TO 2000 : NEXT
  169.   j=j+1
  170.  WEND
  171.  length=j-1
  172. RETURN
  173.  
  174. AskMore:
  175.  LOCATE 17,10
  176.  PRINT "Generate another progression (Y/N)?"
  177.  a$=""
  178.  WHILE a$<>"Y" AND a$<>"N"
  179.   a$=UCASE$(INKEY$)
  180.  WEND
  181.  LOCATE 17,10 : PRINT SPACE$(40)
  182. RETURN
  183.  
  184.  
  185.